{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Plasma;

interface

uses Classes, UIObjects, Graphics, Colours, RenderCache, XMLHelper, AHMTypes;

const
  DEFAULT_DENSITY = 255; // Maximum alpha value for plasma layer
  DEFAULT_SPEED = 1; // Default speed for top plasma layer
  DEFAULT_LAYERS = 2; // Default number of plasma layers
  DEFAULT_DIRECTION = diLeft; // Default direction for plasma movement
  TEXTURE_SIZE = 512; // Size of texture to fit whole screen
  TEXTURE_SCREENS = 2; // Number of whole screens per layer

{$IFDEF DESIGNER}
  // Property categories and hints for designer
  CAT_PLASMA = 'Plasma';
  HINT_LAYERCOUNT = 'specifies the number of plasma layers to display (1-5)';
  HINT_BKCOLOUR = 'defines the background colour for the plasma effect';
  HINT_FRCOLOUR = 'defines the foreground colour for the plasma effect';
  HINT_SPEED = 'specifies the movement speed for the plasma layers (0-10)';
  HINT_DIRECTION = 'specifies the movement direction for the plasma layers';
  HINT_DENSITY = 'defines the density of the plasma effect (range 0-255)';
{$ENDIF}

type
  TAHMPlasmaLayer = class
  private
    FRender: TAHMRenderCache;
    FMaxPosition: Single;
    FPosition: Single;
    FSpeed: Single;
    FVertical: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Animate;
    property Renderer: TAHMRenderCache read FRender;
    property Position: Single read FPosition;
    property Speed: Single read FSpeed write FSpeed;
    property Vertical: Boolean read FVertical write FVertical;
  end;

  TAHMPlasmaLayers = class
  private
    FLayers: TList;
  protected
    function GetCount: Integer;
    procedure SetCount(Count: Integer);
    function GetLayer(Index: Integer): TAHMPlasmaLayer;
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount write SetCount;
    property Layer[Index: Integer]: TAHMPlasmaLayer read GetLayer;
  end;

  TAHMPlasma = class(TAHMUIDisplayObject)
  private
    FValid: Boolean;
    FBackColour: TAHMColour;
    FFrontColour: TAHMColour;
    FSpeed: Single;
    FDirection: TAHMDirection;
    FDensity: Integer;
    FLayers: TAHMPlasmaLayers;
  protected
    function GetLayerCount: Integer;
    procedure SetLayerCount(Count: Integer);
    procedure SetSpeed(Speed: Single);
    procedure SetDirection(Direction: TAHMDirection);
    procedure SetDensity(Density: Integer);
    procedure UpdateLayers;
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    procedure PreRender(Control: TObject; iX, iY, iWidth, iHeight: Single); override;
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single); override;
    procedure SeedObject; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property LayerCount: Integer read GetLayerCount write SetLayerCount;
    property BackColour: TAHMColour read FBackColour write FBackColour;
    property FrontColour: TAHMColour read FFrontColour write FFrontColour;
    property Speed: Single read FSpeed write SetSpeed;
    property Direction: TAHMDirection read FDirection write SetDirection;
    property Density: Integer read FDensity write SetDensity;
  end;

  TAHMPlasmaList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddPlasma(const InheritFrom, NewName: String): TAHMPlasma;
    function GetPlasma(const Name: String): TAHMPlasma;
  end;


implementation

uses SysUtils, ApplicationManager, BaseControls, Containers, ColourRenderer,
     Canvas, TagNames, XMLTags;


constructor TAHMPlasmaLayer.Create;
begin
  inherited Create;

  FRender := TAHMRenderCache.Create;
  FMaxPosition := TEXTURE_SCREENS;
end;

destructor TAHMPlasmaLayer.Destroy;
begin
  FRender.Free;

  inherited Destroy;
end;

procedure TAHMPlasmaLayer.Animate;
begin
  FPosition := FPosition - (FSpeed / 800);
  if FPosition > FMaxPosition then FPosition := FPosition - FMaxPosition
  else if FPosition < 0.0 then FPosition := FPosition + FMaxPosition;
end;

//----------------------------------------------------------------------------//

constructor TAHMPlasmaLayers.Create;
begin
  inherited Create;

  FLayers := TList.Create;
end;

destructor TAHMPlasmaLayers.Destroy;
var
  i: Integer;
begin
  for i := 0 to Pred(FLayers.Count) do
    TAHMPlasmaLayer(FLayers[i]).Free;
  FLayers.Free;

  inherited Destroy;
end;

function TAHMPlasmaLayers.GetCount: Integer;
begin
  Result := FLayers.Count;
end;

procedure TAHMPlasmaLayers.SetCount(Count: Integer);
var
  i: Integer;
  Layer: TAHMPlasmaLayer;
begin
  // Clear all current layers
  for i := 0 to Pred(FLayers.Count) do
    TAHMPlasmaLayer(FLayers[i]).Free;
  FLayers.Clear;

  // Add required number of new layers
  for i := 0 to Pred(Count) do
  begin
    Layer := TAHMPlasmaLayer.Create;
    FLayers.Add(Layer);
  end;
end;

function TAHMPlasmaLayers.GetLayer(Index: Integer): TAHMPlasmaLayer;
begin
  if (Index >= 0) and (Index < FLayers.Count) then
    Result := TAHMPlasmaLayer(FLayers[Index])
  else
    Result := nil;
end;

//----------------------------------------------------------------------------//

constructor TAHMPlasmaList.Create;
begin
  inherited Create;

  XMLTagName := TAG_PLASMAS;
  ChildClass := TAHMPlasma;
end;

function TAHMPlasmaList.AddPlasma(const InheritFrom, NewName: String): TAHMPlasma;
begin
  Result := TAHMPlasma(Inherit(InheritFrom, NewName));
end;

function TAHMPlasmaList.GetPlasma(const Name: String): TAHMPlasma;
begin
  Result := TAHMPlasma(GetObject(Name));
end;


//----------------------------------------------------------------------------//
constructor TAHMPlasma.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_PLASMA;
  ObjectType := otPlasma;
  ImageIndex := Ord(otPlasma);
  PreviewFullscreen := True;
  PreviewEditable := False;

  FLayers := TAHMPlasmaLayers.Create;

  // Set default plasma properties
  ClearProperties;
end;

destructor TAHMPlasma.Destroy;
begin
  FLayers.Free;

  inherited Destroy;
end;

function TAHMPlasma.GetLayerCount: Integer;
begin
  Result := FLayers.Count;
end;

procedure TAHMPlasma.SetLayerCount(Count: Integer);
begin
  if (FLayers.Count <> Count) and (Count > 0) and (Count < 6) then
  begin
    FLayers.Count := Count;
    UpdateLayers;
    FValid := False;
  end;
end;

procedure TAHMPlasma.SetSpeed(Speed: Single);
begin
  if (FSpeed <> Speed) and (Speed <= 10) and (Speed >= 0) then
  begin
    FSpeed := Speed;
    UpdateLayers;
  end;
end;

procedure TAHMPlasma.SetDirection(Direction: TAHMDirection);
begin
  if (FDirection <> Direction) then
  begin
    // Only need to invalidate when swapping horizontal/vertical/none modes
    if ((FDirection = diLeft) and (Direction <> diRight)) or
       ((FDirection = diRight) and (Direction <> diLeft)) or
       ((FDirection = diUp) and (Direction <> diDown)) or
       ((FDirection = diDown) and (Direction <> diUp)) or
       (FDirection = diNone) then FValid := False;
    FDirection := Direction;
    UpdateLayers;
  end;
end;

procedure TAHMPlasma.SetDensity(Density: Integer);
begin
  if (Density <> FDensity) and (Density > 0) and (Density < 256) then
  begin
    FDensity := Density;
    FValid := False;
  end;
end;

procedure TAHMPlasma.UpdateLayers;
var
  i: Integer;
begin
  // Set layer speed according to layer depth and movement direction
  for i := 0 to Pred(FLayers.Count) do
    if FDirection in [diRight, diDown] then
      FLayers.Layer[i].Speed := FSpeed * (i + 1) / 2
    else
      FLayers.Layer[i].Speed := -FSpeed * (i + 1) / 2;
end;

procedure TAHMPlasma.ClearProperties;
begin
  inherited;

  // Clear custom plasma properties
  FBackColour := nil;
  FFrontColour := nil;
  FDensity := DEFAULT_DENSITY;
  FSpeed := DEFAULT_SPEED;
  FDirection := DEFAULT_DIRECTION;
  LayerCount := DEFAULT_LAYERS;
end;

procedure TAHMPlasma.PreRender(Control: TObject; iX, iY, iWidth, iHeight: Single);
var
  Buffer: TAHMDrawBuffer;
  i: Integer;
begin
  // See if plasma layers need to be rebuilt
  for i := 0 to Pred(FLayers.Count) do
    if not FLayers.GetLayer(i).Renderer.Valid then
    begin
      FValid := False;
      Break;
    end;

  if not FValid then
  begin
    // Create temporary buffer to hold plasma
    Buffer := TAHMDrawBuffer.Create;
    try
      // Buffer will store alpha values only
      Buffer.Monochrome := True;

      // Compute texture dimensions depending on scroll direction
      if FDirection in [diUp, diDown] then
      begin
        Buffer.Width := TEXTURE_SIZE;
        Buffer.Height := TEXTURE_SCREENS * TEXTURE_SIZE;
      end
      else if FDirection in [diLeft, diRight] then
      begin
        Buffer.Width := TEXTURE_SCREENS * TEXTURE_SIZE;
        Buffer.Height := TEXTURE_SIZE;
      end
      else // None
      begin
        Buffer.Width := TEXTURE_SIZE;
        Buffer.Height := TEXTURE_SIZE;
      end;

      for i := 0 to Pred(FLayers.Count) do
      begin
        // Render plasma into our drawbuffer
        ColourRendererInstance.PlasmaBitmap(Buffer, FDensity);

        // Cache drawbuffer in rendercache internal texture
        with FLayers.GetLayer(i).Renderer do
        begin
          DrawBuffer := Buffer;
          BuildCache(Buffer.BufferRect);
        end;
      end;
    finally
      Buffer.Free;
    end;

    // Plasma is now valid and ready for rendering
    FValid := True;
  end;
end;

procedure TAHMPlasma.Render(Control: TObject; iX, iY, iWidth, iHeight: Single);
var
  oControl: TAHMAbstractControl;
  Position, Offset: Single;
  i: Integer;
  Start1, Start2: Single;
  Src1Rect, Src2Rect, Dest1Rect, Dest2Rect: TAHMRectF;
  Horizontal, Flipper: Boolean;
begin
  inherited;

  // Get details of passed container & its viewport
  oControl := Control as TAHMAbstractControl;

  // Draw our shape onto control viewport
  with oControl.Viewport, oControl do // Control properties take precedence
  begin
    if FBackColour <> nil then Canvas.BrushColour := FBackColour.Colour
                          else Canvas.BrushColour := nil;

    // Clear background for our plasma effect
    Canvas.ClearRect(CanvasRect(XPos, YPos, Width, Height));

    // Render each of our plasma layers
    for i := 0 to Pred(FLayers.Count) do
    begin
      Horizontal := FDirection in [diLeft, diRight];
      if FDirection = diNone then Position := 0
                             else Position := FLayers.Layer[i].Position;
      if Position > 1 then Offset := Position - 1 else Offset := Position;
      FLayers.Layer[i].Animate;

      // Divide blit into two parts according to offset
      if Horizontal then
      begin
        Src1Rect.Width := 1 - Offset;
        Src2Rect.Width := Offset;
        Src1Rect.Height := 1;
        Src2Rect.Height := 1;
      end
      else
      begin
        // Divide blit into two parts according to offset
        Src1Rect.Width := 1;
        Src2Rect.Width := 1;
        Src1Rect.Height := 1 - Offset;
        Src2Rect.Height := Offset;
      end;

      // Compute source start position rectangles for each blit portion
      if Position < 1 then
      begin
        Start1 := 0;
        Start2 := 0;
        Flipper := False;
      end
      else
      begin
        Start1 := Offset;
        Start2 := 1 - Offset;
        Flipper := True;
      end;

      // Apply source start positions horizontally or vertically as required
      if Horizontal then
      begin
        Src1Rect.X := Start1;
        Src2Rect.X := Start2;
        Src1Rect.Y := 0;
        Src2Rect.Y := 0;
      end
      else
      begin
        Src1Rect.X := 0;
        Src2Rect.X := 0;
        Src1Rect.Y := Start1;
        Src2Rect.Y := Start2;
      end;

      // Scale source rectangles to corresponding destination
      if Horizontal then
      begin
        Dest1Rect.X := iX + Offset * Width;
        Dest1Rect.Y := iY;
        Dest1Rect.Width := Src1Rect.Width * Width;
        Dest1Rect.Height := Height;
        Dest2Rect.X := iX;
        Dest2Rect.Y := iY;
        Dest2Rect.Width := Src2Rect.Width * Width;
        Dest2Rect.Height := Height;
      end
      else
      begin
        Dest1Rect.X := iX;
        Dest1Rect.Y := iY + Offset * Height;
        Dest1Rect.Width := Width;
        Dest1Rect.Height := Src1Rect.Height * Height;
        Dest2Rect.X := iX;
        Dest2Rect.Y := iY;
        Dest2Rect.Width := Width;
        Dest2Rect.Height := Src2Rect.Height * Height;
      end;

      // Flip our blits horizontally or vertically as required
      if Horizontal then
      begin
        FLayers.Layer[i].Renderer.Render(Src1Rect, Dest1Rect, nil, FFrontColour.Colour, XScale, YScale, Flipper, False);
        FLayers.Layer[i].Renderer.Render(Src2Rect, Dest2Rect, nil, FFrontColour.Colour, XScale, YScale, not Flipper, False);
      end
      else
      begin
        FLayers.Layer[i].Renderer.Render(Src1Rect, Dest1Rect, nil, FFrontColour.Colour, XScale, YScale, False, Flipper);
        FLayers.Layer[i].Renderer.Render(Src2Rect, Dest2Rect, nil, FFrontColour.Colour, XScale, YScale, False, not Flipper);
      end;
    end;
  end;
end;

procedure TAHMPlasma.SeedObject;
begin
{$IFDEF DESIGNER}
  if Ancestor = nil then
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
    begin
      BackColour := ColourList.GetColour(DEFAULT_OBJECT_NAME);
      FrontColour := ColourList.GetColour(DEFAULT_WHITE_NAME);
    end;
{$ENDIF}
end;

procedure TAHMPlasma.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMPlasma do
  begin
    Self.LayerCount := LayerCount;
    Self.BackColour := BackColour;
    Self.FrontColour := FrontColour;
    Self.Speed := Speed;
    Self.Direction := Direction;
    Self.Density := Density;
  end;
end;

procedure TAHMPlasma.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMPlasma;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMPlasma(ObjectToCompare);

  // Only populate attributes that differ from our ancestor
  if (FBackColour <> nil) and (FBackColour <> oAncs.BackColour) then
    Lines.Add(TABS[3] + TGB+TAG_BACKCOLOUR+SPC+ATTR_NAME+ATB + EncodeXML(FBackColour.Name) + ATE);
  if (FFrontColour <> nil) and (FFrontColour <> oAncs.FrontColour) then
    Lines.Add(TABS[3] + TGB+TAG_FRONTCOLOUR+SPC+ATTR_NAME+ATB + EncodeXML(FFrontColour.Name) + ATE);
  if (LayerCount <> DEFAULT_LAYERS) and (LayerCount <> oAncs.LayerCount) then
    Lines.Add(TABS[3] + TGB+TAG_LAYERS+TGC + IntToStr(LayerCount) + TGE+TAG_LAYERS+TGC);
  if (FSpeed <> DEFAULT_SPEED) and (FSpeed <> oAncs.Speed) then
    Lines.Add(TABS[3] + TGB+TAG_SPEED+TGC + Float2Str(FSpeed) + TGE+TAG_SPEED+TGC);
  if (FDirection <> DEFAULT_DIRECTION) and (FDirection <> oAncs.Direction) then
    Lines.Add(TABS[3] + TGB+TAG_DIRECTION+TGC + Direction2Str(FDirection) + TGE+TAG_DIRECTION+TGC);
  if (FDensity <> DEFAULT_DENSITY) and (FDensity <> oAncs.Density) then
    Lines.Add(TABS[3] + TGB+TAG_DENSITY+TGC + IntToStr(FDensity) + TGE+TAG_DENSITY+TGC);
end;

procedure TAHMPlasma.ParseFromXML(XML: TAHMXMLHelper);
var
  sName, sValue: String;
  PlasmaNode, PropsNode: TAHMXMLNode;
begin
  // Initialise parsing nodes
  PlasmaNode := XML.CurrentNode;
  PropsNode := nil;

  // Some plasma elements are optional, so lets see what we've got
  while XML.NextElement(PlasmaNode, PropsNode) do
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
      if XML.CurrentElement = TAG_BACKCOLOUR then
      begin
        sName :=  XML.GetAttribute(ATTR_NAME);
        if sName <> '' then BackColour := ColourList.GetColour(sName);
      end
      else if XML.CurrentElement = TAG_FRONTCOLOUR then
      begin
        sName :=  XML.GetAttribute(ATTR_NAME);
        if sName <> '' then FrontColour := ColourList.GetColour(sName);
      end
      else if XML.CurrentElement = TAG_LAYERS then
      begin
        sValue := XML.GetValue;
        if sValue <> '' then LayerCount := StrToIntDef(sValue, DEFAULT_LAYERS);
      end
      else if XML.CurrentElement = TAG_SPEED then
      begin
        sValue := XML.GetValue;
        if sValue <> '' then Speed := StrToFloatDef(sValue, DEFAULT_SPEED);
      end
      else if XML.CurrentElement = TAG_DIRECTION then
      begin
        sValue := XML.GetValue;
        if sValue <> '' then Direction := Str2Direction(sValue);
      end
      else if XML.CurrentElement = TAG_DENSITY then
      begin
        sValue := XML.GetValue;
        if sValue <> '' then Density := StrToIntDef(sValue, DEFAULT_DENSITY);
      end;
end;

procedure TAHMPlasma.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom plasma properties
  Properties.Add('Layers', 'LayerCount', CAT_PLASMA, HINT_LAYERCOUNT);
  Properties.Add('Back Colour', 'BackColour', CAT_PLASMA, HINT_BKCOLOUR);
  Properties.Add('Front Colour', 'FrontColour', CAT_PLASMA, HINT_FRCOLOUR);
  Properties.Add('Speed', 'Speed', CAT_PLASMA, HINT_SPEED);
  Properties.Add('Direction', 'Direction', CAT_PLASMA, HINT_DIRECTION);
  Properties.Add('Density', 'Density', CAT_PLASMA, HINT_DENSITY);
{$ENDIF}
end;

end.
